home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ANSI.SWG / 0025_ANSI Save Screen.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  4KB  |  155 lines
  1. {
  2. > 2: Writing ansi screens to directly to a file.
  3.  
  4.   2.  What exactly do you mean by writing ANSI screens to a file?
  5.       Do you mean a text mode screen to the ANSI file format,
  6.       or interpreting an ANSI file to a text mode screen?
  7.  
  8.     I have code that will save a textmode screen to an ANSI format
  9.   text file by reading the text mode screen directly.  The code came
  10.   from another discussion on saving text screens to ANSI files;
  11.   the code is not mine.
  12. }
  13.  
  14. PROGRAM Ansi_Save_Screen;
  15. {*
  16.  *  Save a color-screen in Ansi-format. Simple way, char by char: blanks
  17.  *  not skipped.
  18.  *}
  19. Uses
  20.   Dos;
  21.  
  22. PROCEDURE SaveANSI(Filename : PathStr);
  23. CONST
  24.   Esc      = #27;
  25.   MaxCol   = 70;
  26.   AnsiCols : array [0..7] of char = '04261537';
  27.  
  28. TYPE
  29.   TCell = RECORD
  30.     C : Char;
  31.     A : byte;
  32.   END;
  33.   TScreen = array [1..25, 1..80] of TCell;
  34.  
  35.   ANSIATTR = record
  36.     Bright : boolean;
  37.     Blink  : boolean;
  38.     FG     : byte;
  39.     BG     : byte;
  40.   end;
  41.  
  42. VAR
  43.   Screen   : TSCreen ABSOLUTE $B800:$0000;
  44.   F        : text;
  45.   X, Y     : byte;
  46.   s, s1    : String;
  47.   AnsiLast,
  48.   AnsiTmp  : ANSIATTR;
  49.  
  50. function WriteAttr(var Old, New : ANSIATTR) : string;
  51. { Write Attributes (ESC[..m) into a string }
  52. var
  53.   s : string;
  54. begin
  55.   WriteAttr := '';
  56.   s := ESC + '[';
  57.   if (not(New.Bright = Old.Bright)) or (not(New.Blink = Old.Blink)) then
  58.   begin
  59.     if (Not (New.Bright and New.Blink)) then
  60.       s := s + '0;'
  61.     else
  62.     if (not New.Bright) and (New.Blink) then
  63.     begin
  64.       if Old.Bright then
  65.         s := s + '0;5;'
  66.       else
  67.         s := s + '5;';
  68.     end
  69.     else
  70.     if (New.Bright) and (not New.Blink) then
  71.     begin
  72.       if Old.Blink then
  73.         s := s + '0;1;'
  74.       else
  75.         s := s + '1;';
  76.     end
  77.     else
  78.     begin
  79.       if not Old.Bright then
  80.         s := s + '1;';
  81.       if not Old.Blink then
  82.         s := s + '5;';
  83.     end;
  84.   end;
  85.  
  86.   if (Old.FG <> New.FG) or ((not New.Bright) and Old.Bright) or
  87.                            ((not New.Blink) and Old.Blink) then
  88.   begin
  89.     {*  I don't have no info why, but obviously backswitching to dark
  90.      *  colorset, what has to be done via ^[0m, must turn fg/bg colors to
  91.      *  37/40. However, we can optimize still then a bit !-. *}
  92.     if not ( (New.FG=7) and ((not New.Bright) and Old.Bright) )
  93.        then s:=s+'3'+AnsiCols[New.FG]+';';
  94.   end;
  95.  
  96.   if (Old.BG<>New.BG) or ((not New.Bright) and Old.Bright) or
  97.                          ((not New.Blink) and Old.Blink) then
  98.   begin
  99.     if not ( (New.BG=0) and ((not New.Bright) and Old.Bright) )
  100.        then s:=s+'4'+AnsiCols[New.BG]+';';
  101.   end;
  102.  
  103.   if s[length(s)]=';' then s[length(s)]:='m' else s:=s+'m';
  104.  
  105.   if length(s)>length(ESC+'[m') then WriteAttr:=s;
  106. end;
  107.  
  108. BEGIN
  109.   Assign(F, filename);
  110.   Rewrite(F);
  111.  
  112.   AnsiTmp.FG := Screen[1, 1].A and 15;
  113.   AnsiTmp.BG := Screen[1, 1].A SHR 4;
  114.   AnsiTmp.Blink := (AnsiTmp.BG AND 8) = 8;
  115.   AnsiTmp.Bright := (AnsiTmp.FG AND 8) = 8;
  116.   AnsiTmp.FG:=AnsiTmp.FG and 7;
  117.   AnsiTmp.BG:=AnsiTmp.BG and 7;
  118.  
  119.   s:=Esc+'[2J'+Esc+'[0m'+ESC+'[';
  120.   if AnsiTmp.Bright then s:=s+'1;';
  121.   if AnsiTmp.Blink then s:=s+'5;';
  122.   s:=s+'3'+ansicols[AnsiTmp.FG]+';';
  123.   s:=s+'4'+ansicols[AnsiTmp.BG]+'m';
  124.  
  125.   FOR Y := 1 TO 25 DO
  126.     BEGIN
  127.      FOR X := 1 TO 80 DO
  128.        BEGIN
  129.          AnsiLast:=AnsiTmp;
  130.  
  131.          AnsiTmp.FG := Screen[Y, X].A AND 15;
  132.          AnsiTmp.BG := Screen[Y, X].A SHR 4;
  133.          AnsiTmp.Bright := (AnsiTmp.FG AND 8)<>0;
  134.          AnsiTmp.Blink := (AnsiTmp.BG AND 8)<>0;
  135.          AnsiTmp.FG:=AnsiTmp.FG and 7;
  136.          AnsiTmp.BG:=AnsiTmp.BG and 7;
  137.  
  138.          s1:=WriteAttr(AnsiLast, AnsiTmp);
  139.          s1:=s1+Screen[Y, X].C;
  140.  
  141.          IF (length(s+s1+ESC+'[s')) <= MaxCol then s:=s+s1 else
  142.          begin
  143.            Write(F,s+ESC+'[s'+#13#10);
  144.            s:=ESC+'[u'+s1;
  145.          end;
  146.  
  147.        END;
  148.     END;
  149.     Write(F, Esc+'[0;37;40m');
  150.     Close(F);
  151. END;
  152. BEGIN
  153.   SaveANSI('test3.ans');
  154. END.
  155.